home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / More classes / Sets < prev    next >
Text File  |  1991-09-09  |  2KB  |  89 lines
  1. ¥ Some experimentation.
  2.  
  3. : ET!        immediate
  4.     $ 201E w,                ¥    POP.L    D0
  5.     $ 41BC w,                ¥    CHK    #nn,D0
  6.     w,                    ¥        (nn)
  7.     $ 1480 w,                ¥    MOVE.B    D0,(A2)
  8.     ;
  9.  
  10.     0    value    X
  11.     0    value    LO
  12.     0    value    HI
  13.  
  14. : (DO_ET)
  15.     typecnt 1 -  -> x
  16.     " :m SIZE: [ x ] lit ;m"    evaluate
  17.     " :m PUT: [ x ] et! ;m"    evaluate  ;
  18.  
  19. ' (do_ET) -> do_ET
  20.  
  21.  
  22. :class    ENUM-TYPE    super{  byte  }        ¥ Generic supertype for all enumerated
  23.                         ¥ types.
  24.  
  25. :m  GET:        ^base c@   ;m
  26. :m  ->:        chksame  c@  ^base c!   ;m
  27.  
  28. ;class
  29.  
  30.  
  31. : IS_RANGE
  32.     -> hi  -> lo   hi lo -  -> x
  33.     " :m RANGE:    [ lo ] lit [ hi ] lit ;m"    evaluate
  34.     " :m PUT:    [ lo ] lit -  [ x ] et! ;m"    evaluate
  35.     " :m GET:    ^base c@  [ lo ] lit + ;m"    evaluate   ;
  36.  
  37.  
  38. :class    RANGE    super{  byte  }
  39.  
  40. :m  ->:    chksame  c@  ^base c!   ;m
  41.  
  42. ;class
  43.  
  44.  
  45.     0    value    SZ
  46.     0    value    LN
  47.  
  48. : ELEMENT_IS
  49.     " SIZE:" here place  here hash
  50.     '                    ¥ ^class
  51.     findm  nip  execute  -> sz
  52.     sz 1-  3 >>  1+  -> ln
  53.     ln  ^class dfa w+!            ¥ Allocate the space
  54.                         ¥ Now we define the methods:
  55.     " :m SIZE: [ sz ] lit ;m"    evaluate
  56.     " :m LEN:  [ ln ] lit ;m"    evaluate  ;
  57.  
  58.  
  59. :class  SET    super{  object  }
  60.  
  61. :m  +:    ^base swap bset   ;m
  62. :m  -:    ^base swap breset   ;m
  63.  
  64. :m  IN?:    inline{ obj swap btest}
  65.     ^base swap btest   ;m
  66.  
  67. :m CLASSINIT:
  68.     len: [self]
  69.     for   0 ^base i +  c!  next  ;m
  70.  
  71. ;class
  72.  
  73. ¥ endload
  74.  
  75. :class    DAY    super{  enum-type  }
  76.     type{ sunday monday tuesday wednesday thursday friday saturday }
  77. ;class
  78.  
  79. :class    DAYS    super{ set }    element_is  day
  80. ;class
  81.  
  82. day    TODAY
  83. day    YESTERDAY
  84. days    WEEKEND    saturday +: weekend   sunday +: weekend
  85.  
  86. :class    RRR    super{ range }    100 200 is_range
  87. ;class
  88.  
  89.